{-# LANGUAGE OverloadedStrings #-}

module RenderDocs where

import CMark
import Control.Monad (when)
import qualified Data.List as List
import Data.Maybe (fromMaybe)
import Data.Text as Text
import qualified Env as E
import qualified Map
import qualified Meta
import Obj
import Path
import Project
import Text.Blaze.Html.Renderer.Pretty (renderHtml)
import Text.Blaze.Html5 ((!))
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html5.Attributes as A
import TypeError (typeVariablesInOrderOfAppearance)
import Types

-- TODO: Move the beautification to a much earlier place, preferably when the function is defined/concretized-
-- This might be a duplicate with the work in a PR by @jacereda
beautifyType :: Ty -> Ty
beautifyType t =
  let tys = List.nub (typeVariablesInOrderOfAppearance t)
      mappings =
        Map.fromList
          ( List.zip
              (List.map go tys)
              (List.map (VarTy . (: [])) ['a' ..])
          )
   in replaceTyVars mappings t
  where
    go :: Ty -> String
    go (VarTy name) = name
    go _ = "" -- called on a non var type.

saveDocsForEnvs :: Project -> [(SymPath, Binder)] -> IO ()
saveDocsForEnvs ctx pathsAndEnvBinders =
  let dir = projectDocsDir ctx
      title = projectTitle ctx
      generateIndex = projectDocsGenerateIndex ctx
      dependencies = getDependenciesForEnvs (Prelude.map (\(p, b) -> (p, fst (getEnvAndMetaFromBinder b))) pathsAndEnvBinders)
      pathsAndEnvBinders' = pathsAndEnvBinders ++ dependencies
      allEnvNames = fmap fst pathsAndEnvBinders'
   in do
        mapM_ (saveDocsForEnvBinder ctx allEnvNames) pathsAndEnvBinders'
        when
          generateIndex
          ( writeFile
              (dir </> title ++ "_index.html")
              (projectIndexPage ctx allEnvNames)
          )
        putStrLn ("Generated docs to '" ++ dir ++ "'")
  where
    getDependenciesForEnvs = Prelude.concat . Prelude.map getEnvDependencies
    getEnvDependencies (SymPath ps p, e) =
      let envs =
            Prelude.map
              (\(n, b) -> (SymPath (ps ++ [p]) n, b))
              ( Prelude.filter
                  (\(_, Binder _ x) -> isMod x)
                  ( Prelude.filter
                      shouldEmitDocsForBinder
                      (Map.toList (envBindings e))
                  )
              )
       in envs
            ++ getDependenciesForEnvs (Prelude.map go envs)
      where
        go :: (SymPath, Binder) -> (SymPath, Env)
        go (n, Binder _ (XObj (Mod env _) _ _)) = (n, env)
        go _ = ((SymPath [] ""), E.empty)

-- | This function expects a binder that contains an environment, anything else is a runtime error.
getEnvAndMetaFromBinder :: Binder -> (Env, MetaData)
getEnvAndMetaFromBinder envBinder =
  case envBinder of
    Binder meta (XObj (Mod env _) _ _) -> (env, meta)
    _ -> error "Binder's not a module. This should be detected in 'commandSaveDocsInternal'."

projectIndexPage :: Project -> [SymPath] -> String
projectIndexPage ctx moduleNames =
  let logo = projectDocsLogo ctx
      url = projectDocsURL ctx
      css = projectDocsStyling ctx
      htmlHeader = H.toHtml $ projectTitle ctx
      htmlDoc = commonmarkToHtml [optSafe] $ Text.pack $ projectDocsPrelude ctx
      html = renderHtml $
        H.docTypeHtml $
          do
            headOfPage css
            H.body $
              H.div ! A.class_ "content" $
                H.a ! A.href (H.stringValue url) $
                  do
                    H.div ! A.class_ "logo" $
                      do
                        H.img ! A.src (H.stringValue logo) ! A.alt "Logo"
                        moduleIndex moduleNames
                    H.div $
                      do
                        H.h1 htmlHeader
                        H.preEscapedToHtml htmlDoc
   in html

headOfPage :: String -> H.Html
headOfPage css =
  H.head $
    do
      H.meta ! A.charset "UTF-8"
      H.meta ! A.name "viewport" ! A.content "width=device-width, initial-scale=1.0, maximum-scale=1.0, user-scalable=0"
      H.link ! A.rel "stylesheet" ! A.href (H.stringValue css)

getModuleName :: Env -> String
getModuleName env = fromMaybe "Global" (envModuleName env)

saveDocsForEnvBinder :: Project -> [SymPath] -> (SymPath, Binder) -> IO ()
saveDocsForEnvBinder ctx moduleNames (envPath, envBinder) =
  do
    let moduleName = show envPath
        dir = projectDocsDir ctx
        fullPath = dir </> moduleName ++ ".html"
        string = renderHtml (envBinderToHtml envBinder ctx (show envPath) moduleNames)
    createDirectoryIfMissing False dir
    writeFile fullPath string

envBinderToHtml :: Binder -> Project -> String -> [SymPath] -> H.Html
envBinderToHtml envBinder ctx moduleName moduleNames =
  let (env, meta) = getEnvAndMetaFromBinder envBinder
      title = projectTitle ctx
      css = projectDocsStyling ctx
      url = projectDocsURL ctx
      logo = projectDocsLogo ctx
      moduleDescription = case Meta.get "doc" meta of
        Just (XObj (Str s) _ _) -> s
        Nothing -> ""
        _ -> error "moduledescription"
      moduleDescriptionHtml = commonmarkToHtml [optSafe] $ Text.pack moduleDescription
   in H.docTypeHtml $
        do
          headOfPage css
          H.body $
            H.div ! A.class_ "content" $
              do
                H.div ! A.class_ "logo" $
                  do
                    H.a ! A.href (H.stringValue url) $
                      H.img ! A.src (H.stringValue logo)
                    --span_ "CARP DOCS FOR"
                    H.div ! A.class_ "title" $ H.toHtml title
                    moduleIndex moduleNames
                H.div ! A.class_ "module" $
                  do
                    H.h1 (H.toHtml moduleName)
                    H.div ! A.class_ "module-description" $ H.preEscapedToHtml moduleDescriptionHtml
                    mapM_ (binderToHtml moduleName . snd) (Prelude.filter shouldEmitDocsForBinder (Map.toList (envBindings env)))

shouldEmitDocsForBinder :: (String, Binder) -> Bool
shouldEmitDocsForBinder (_, Binder meta _) =
  not (metaIsTrue meta "hidden")

moduleIndex :: [SymPath] -> H.Html
moduleIndex moduleNames =
  H.div ! A.class_ "index" $ grouped moduleNames
  where
    grouped names = H.ul $ mapM_ gen (order names)
    gen (m, subs) =
      H.li $
        if Prelude.null subs
          then moduleLink m
          else H.details $
            do
              H.summary (moduleLink m)
              grouped subs
    order [] = []
    order (m : mods) =
      let (isIn, isNotIn) = List.partition (symBelongsToMod m) mods
       in (m, isIn) : order isNotIn
    symBelongsToMod (SymPath xs x) (SymPath ys y) =
      List.isPrefixOf (xs ++ [x]) (ys ++ [y])

moduleLink :: SymPath -> H.Html
moduleLink p@(SymPath _ name) =
  H.a ! A.href (H.stringValue (show p ++ ".html")) $ H.toHtml name

binderToHtml :: String -> Binder -> H.Html
binderToHtml moduleName (Binder meta xobj) =
  let name = getSimpleName xobj
      maybeNameAndArgs = getSimpleNameWithArgs xobj
      description = getBinderDescription xobj
      typeSignature = case xobjTy xobj of
        Just t -> show (beautifyType t) -- NOTE: This destroys user-defined names of type variables!
        Nothing -> ""
      isDeprecated = case Meta.get "deprecated" meta of
        Just (XObj (Bol True) _ _) -> True
        Just (XObj (Str _) _ _) -> True
        _ -> False
      deprecationStr = case Meta.get "deprecated" meta of
        Just (XObj (Str s) _ _) -> commonmarkToHtml [optSafe] $ Text.pack s
        _ -> ""
      docString = case Meta.get "doc" meta of
        Just (XObj (Str s) _ _) -> s
        Just found -> pretty found
        Nothing -> ""
      htmlDoc = commonmarkToHtml [optSafe] $ Text.pack docString
   in H.div ! A.class_ "binder" $
        do
          H.a ! A.class_ "anchor" ! A.href (H.stringValue ("#" ++ name)) $
            H.h3 ! A.id (H.stringValue name) $
              do
                if isMod xobj
                  then H.a ! A.href (H.stringValue (moduleName ++ "." ++ pretty xobj ++ ".html")) $ H.toHtml (pretty xobj)
                  else H.toHtml name
                when isDeprecated $
                  H.span ! A.class_ "deprecation-notice" $
                    H.toHtml ("deprecated" :: String)
          H.div ! A.class_ "description" $ H.toHtml description
          H.p ! A.class_ "sig" $ H.toHtml typeSignature
          case maybeNameAndArgs of
            Just nameAndArgs -> H.pre ! A.class_ "args" $ H.toHtml nameAndArgs
            Nothing -> H.span $ H.toHtml ("" :: String)
          H.p ! A.class_ "doc" $ H.preEscapedToHtml htmlDoc
          when isDeprecated $
            H.div ! A.class_ "deprecation-text" $
              H.preEscapedToHtml deprecationStr

--p_ (toHtml (description))
